home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / _F_ERROR.PRG < prev    next >
Text File  |  1993-05-04  |  4KB  |  130 lines
  1. *' $Header:   E:/test/sysproc/doc/_f_error.prv   1.0   12 Aug 1992 16:56:06   Bill Ramos  $
  2. PROCEDURE _F_Error
  3. *-------------------------------------------------------------------------------
  4. * NAME
  5. *   _F_Error
  6. *
  7. * DESCRIPTION
  8. *   Error routine called by Multi-file and Edit forms.  Also used by
  9. *   Design surface programs.
  10. *
  11. * SYNOPSIS
  12. *   DO _F_Error
  13. *
  14. * PARAMETERS
  15. *   None
  16. *
  17. * DEPENDENCIES
  18. *   fxl_edit    = Edit or M-D form, .T. if EDIT, .F. if M-D form
  19. *   fxl_error   = Global, pass to calling program .T. if error occured
  20. *   gl_append   = M-D form, .T. performing append on the master file
  21. *   gl_appendc  = M-D form, .T. performing append on detail file
  22. *   gn_recno    = M-D form, record # before attempting append operation
  23. *   gl_draw     = M-D form, .T. means redraw on return, .F. don't
  24. *   ll_samerec  = M-D form, .T. means on the same record, .F. not
  25. *
  26. * VARIABLES
  27. *   ln_error    = Error number returned by ERROR()
  28. *
  29. *-------------------------------------------------------------------------------
  30.   PRIVATE ln_error, ll_ans, ln_mssg, lc_mssg
  31.  
  32.   ln_error = ERROR()
  33.   DO CASE
  34.  
  35.     *-- Form run time error, more than one user appending
  36.     CASE ( (TYPE("gl_append")  = "L" .AND. gl_append) .OR.;
  37.            (TYPE("gl_appendc") = "L" .AND. gl_appendc)).AND. ;
  38.          (ln_error = 108 .OR. ln_error = 372)
  39.  
  40.       lc_mssg = [ Another user is appending. Retry?]
  41.       ln_mssg = LEN(lc_mssg)
  42.       ll_ans = _NodShake(lc_mssg,5,17,1,ln_mssg + 2,.F.)
  43.       IF ll_ans
  44.         RETRY
  45.       ELSE
  46.         GO gn_recno
  47.         IF .NOT. COMPLETED()
  48.           ROLLBACK
  49.         ENDIF
  50.       ENDIF
  51.  
  52.     CASE (ln_error = 108 .OR. ln_error = 372) && Record or File lock error
  53.  
  54.       lc_mssg = [ File in use by ] +;
  55.                           IIF( ISBLANK( LKSYS(2) ), [another], LKSYS(2)) + ;
  56.                           [. Retry?]
  57.       ln_mssg = LEN(lc_mssg)
  58.       ll_ans = _NodShake(lc_mssg,5,17,1,ln_mssg + 2,.F.)
  59.       IF ll_ans
  60.         RETRY
  61.       ELSE
  62.         IF TYPE( "gl_draw" ) <> "U"       && If a M-D form
  63.           GO gn_recno
  64.           IF .NOT. COMPLETED()
  65.             ROLLBACK
  66.           ENDIF
  67.         ELSE
  68.           RELEASE FXL_Error
  69.           PUBLIC FXL_Error
  70.           FXL_Error = .T.               && Indicate error handler call
  71.           RETURN
  72.         ENDIF
  73.       ENDIF
  74.  
  75.     OTHERWISE                           && Critical Error - Return to CC
  76.  
  77.       RELEASE FXL_Error
  78.       PUBLIC FXL_Error
  79.       FXL_Error = .T.                   && Indicate error handler call
  80.  
  81.       DO _Err_Box WITH Message()
  82.  
  83.       IF TYPE("FXL_EDIT") = "L" .AND. FXL_EDIT
  84.         KEYBOARD "{27}"
  85.       ENDIF
  86.  
  87.       IF TYPE("FXL_EDIT") = "L" .AND. .NOT. FXL_EDIT
  88.  
  89.         *-- Start clearing .dbf out of all other workareas past 1
  90.         IF .NOT. COMPLETED()
  91.           ROLLBACK
  92.         ENDIF
  93.  
  94.         CLOSE DATABASES
  95.         IF .NOT. ISBLANK( fxc_mastdb )
  96.           DO _OpenDBF WITH fxc_mastdb, 1, .T.
  97.         ENDIF
  98.         SET CURSOR ON
  99.         RELEASE FXL_Edit, FXL_Error
  100.  
  101.         IF fxl_isscb .AND. fxc_dbtrap = "ON"
  102.           SET DBTRAP ON
  103.         ENDIF
  104.  
  105.         RELEASE FXC_ctag
  106.  
  107.         DO _FXEcREnv                  && Reset the operating environment
  108.  
  109.         RELEASE fxl_escape, fxl_exact, fxl_fields, fxl_near, fxl_safety, ;
  110.                 fxc_dbtrap, fxl_isscb, fxc_mastdb, fxl_talk
  111.  
  112.         ON ERROR
  113.  
  114.         RETURN TO MASTER
  115.  
  116.       ENDIF
  117.  
  118.   ENDCASE
  119.  
  120.   ll_samerec = .T.
  121.   gl_draw = .F.
  122.  
  123. RETURN
  124. *-- EOP:  _F_Error
  125. *'-------------------------------------------------------------------------
  126. *' $Log:   E:/test/sysproc/doc/_f_error.prv  $
  127. *'-------------------------------------------------------------------------
  128.  
  129.  
  130.